home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Applications / TCPExample / PNL Libraries / MyAssertions.p < prev    next >
Text File  |  1997-06-20  |  2KB  |  79 lines
  1. unit MyAssertions;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.  
  8. {$ifc undefined do_debug}
  9. {$setc do_debug := 1}
  10. {$endc}
  11.  
  12. {$ifc not do_debug}
  13. {$definec Assert(b)}
  14. {$definec SafeDebugStr(s)}
  15. {$definec AssertValidPtr(p)}
  16. {$definec AssertValidPtrNil(p)}
  17. {$definec AssertValidHandle(p)}
  18. {$definec AssertValidHandleNil(p)}
  19. {$elsec}
  20. {$definec Assert(b) AssertCode(b)}
  21. {$definec SafeDebugStr(b) DebugStr(s)}
  22. {$definec AssertValidPtr(p) AssertValidPtrCode(p)}
  23. {$definec AssertValidPtrNil(p) AssertValidPtrNilCode(p)}
  24. {$definec AssertValidHandle(p) AssertValidHandleCode(p)}
  25. {$definec AssertValidHandleNil(p) AssertValidHandleNilCode(p)}
  26. {$endc}
  27.  
  28. {$ifc do_debug}
  29.     procedure AssertCode (b: boolean);
  30.     procedure AssertValidPtrCode (p: univ Ptr);
  31.     procedure AssertValidPtrNilCode (p: univ Ptr);
  32.     procedure AssertValidHandleCode (hhhh: univ Handle);
  33.     procedure AssertValidHandleNilCode (hhhh: univ Handle);
  34. {$endc}
  35.  
  36. implementation
  37.  
  38.     uses
  39.         Memory;
  40.  
  41. {$ifc do_debug}
  42.     procedure AssertCode (b: boolean);
  43.     begin
  44.         if not b then begin
  45.             DebugStr('Assert Failed;sc;hc');
  46.         end;
  47.     end;
  48.  
  49.     procedure AssertValidPtrCode (p: univ Ptr);
  50.     begin
  51.         Assert((p <> nil) & (not odd(ord4(p))));
  52.     end;
  53.  
  54.     procedure AssertValidPtrNilCode (p: univ Ptr);
  55.     begin
  56.         if p <> nil then begin
  57.             AssertValidPtr(p);
  58.         end;
  59.     end;
  60.  
  61.     procedure AssertValidHandleCode (hhhh: univ Handle);
  62.     begin
  63.         AssertValidPtr(hhhh);
  64.         AssertValidPtr(hhhh^);
  65.         Assert(RecoverHandle(hhhh^) = hhhh);
  66.     end;
  67.  
  68.     procedure AssertValidHandleNilCode (hhhh: univ Handle);
  69.     begin
  70.         if hhhh <> nil then begin
  71.             AssertValidHandle(hhhh);
  72.         end;
  73.     end;
  74. {$endc}
  75.     
  76. end.
  77.  
  78.  
  79.